#|_________________________________________________
 | 
 | ViSta - The Visual Statistics System
 | Copyright (c) 1991-2001 by Forrest W. Young
 | For further information contact the author 
 | forrest@www.visualstats.org
 | http://www.visualstats.org
 |
 | VISTA2.LSP - VISTA RUNTIME INSTALLER (FILE 3 OF 3)
 |_________________________________________________
 |#

(defun desktop-style ()
  (setf *desktop-style* 
        (if *seamless-desktop* 
            (if *thin-borders* 1 3)
            (if *thin-borders* 7 8)))
  *desktop-style*)


(defun screen-size-kludge ()
 (setf *win-screen-size* (effective-screen-size)) 
 (labels ((desktop-loc-size 
           ()
           (if *full-screen*
               (combine 14 34 (- (effective-screen-size) (list 28 48)))
               (combine 14 34 (floor (* 3/4 (screen-size))))))

          (start-size 
           ()
           (when *verbose* (format t "Setting initial locations and sizes~%"))
           
           (setf *mainwindow-loc-size* (combine 4 24 (floor (* 3/4 (screen-size)))))
           (setf *listener-loc-size* (combine 4 24 (- (select *mainwindow-loc-size* (list 2 3)) (list 8 28))))
           (apply #'listener *listener-loc-size*)
           (apply #'mainwindow *mainwindow-loc-size*)
           (setf *desktop-loc-size* (desktop-loc-size)))
          )
   (cond 
   ((< *run-number* 2) (start-size)) 
   (t 
    (if (or (position nil *mainwindow-loc-size*)
            (position nil *listener-loc-size* ))
        (start-size))
    (apply #'mainwindow *mainwindow-loc-size*)
    (apply #'listener *listener-loc-size*)))
   (when (or (not (not (member nil *listener-loc-size*)))
             (< (third *listener-loc-size*) 250) 
             (< (fourth *listener-loc-size*) 100))
         (start-size))
 
   (when (or (not (not (member nil *desktop-loc-size*)))
             (< (third *desktop-loc-size*) 500) 
             (< (fourth *desktop-loc-size*) 350))
         (setf *desktop-loc-size* (desktop-loc-size)))
   (setf *desktop-start-loc-size* (+ '(4 4 -8 -8) *desktop-loc-size*))
   (setf *mainwindow-start-loc-size* *mainwindow-loc-size*)
   (apply #'mainwindow *mainwindow-loc-size*) 
   (listener 4 24 (- (third *mainwindow-loc-size*) 8)
             (- (fourth *mainwindow-loc-size*) 46))
   (setf *listener-start-loc-size* (listener))
 ))



(defun reset-screen-size ()  
  (setf *screen-size* (screen-size))
  #+containers(defun screen-size () (effective-screen-size))
  (setf screen-size *screen-size*)
  (setf *max-screen-size* (screen-size)) 
  (setf *screen-size-adjustment* 
	#+msdos (list 0 0) ;4 24 ;4 54
	#-msdos (list 0 22))
  (setf *3/4-screen-size*                
        (- (floor (* 3/4 (screen-size))) *screen-size-adjustment*))
  (setf *text-window-size*
        #+macintosh (list 490 (max 112 (min 280 (- (second *screen-size*) 326))))
        #-macintosh (list 490 280)
        )
  (setf *text-window-location* 
        #+macintosh(list 10 (min 322 (- (first (screen-size)) 138))) 
        #-macintosh(list 10 30)
        )
  (when *verbose*
      (format t "*3/4-screen-size*          ~d~%" *3/4-screen-size*)
      (format t "*now-screen-size*          ~d~%" *now-screen-size*)
      (format t "*max-screen-size*          ~d~%" *max-screen-size*)
      (format t "*previous-max-screen-size* ~d~%" *previous-max-screen-size*)
      (format t "(screen-size) ~d~%" (screen-size))
      (format t "*screen-size* ~d~%" *screen-size*)
      (format t " screen-size  ~d~%"  screen-size )
      (format t "*screen-size-adjustment* ~d~%" *screen-size-adjustment*)
      (when (= (sum *now-screen-size*) 0) 
            (format t "; initializing screen size~%"))
        (when (/= 0 (sum (- *max-screen-size* *previous-max-screen-size*)))
              (format t "; screen size has changed~%")))
  
  (when (or (= (sum *now-screen-size*) 0)
            (/= 0 (sum (- *max-screen-size* *previous-max-screen-size*))))
        (setf *needs-desktop-resized* t)
       ; (setf *full-screen* t)
        (if *full-screen* 
            (if (= 1 *run-number*)
                (setf *screen-size* (- *max-screen-size* '(40 40)))
                (setf *screen-size* *max-screen-size*))
            (setf *screen-size* *3/4-screen-size*))
        (setf *now-screen-size* *screen-size*)
        (setf screen-size  *screen-size*))
  (setf *previous-max-screen-size* *max-screen-size*)
  (unless *desktop-loc-size*
          (setf *desktop-loc-size* (combine '(50 50) *3/4-screen-size*)))
  (when *verbose*
        (format t "*desktop-loc-size*         ~d~%" *desktop-loc-size*))
  (setf *mainwindow-loc-size* (mainwindow))
  (write-prefload-file)
  *needs-desktop-resized*)


(defun set-desktop-loc-size (&optional (open t))
  (when (and open 
             *desktop-container* 
             (send *desktop-container* :has-slot 'showing)
             (send *desktop-container* :showing))
        (combine (- (send *desktop-container* :location) '(0 0)) ;'(4 4)
                 (+ (send *desktop-container* :size) '(0 0)))))  ;'(8 8)



;following functions don't compile right in 3.52.13

;; modified by PV to deal with missing data 30.7.98
(defun center (data)
"Args: DATA
Centers the columns of the matrix DATA. Returns a matrix."
  (apply #'bind-columns 
         (map-elements #'function-with-missing  #'(lambda (x) (- x (mean x))) 
                       (column-list data)) ) )


;; modified by PV to deal with missing data 30.7.98
(defun correlation-matrix (matrix &key types)
"Args: (matrix &key types)
 Takes a nxm multivariate matrix and returns an nxn correlation matrix. Types is 
an m-vector of variable type strings (category, ordinal, numeric). Uses all n 
of the input matrix's variables if :types not specified, only the numeric variables if :types is specifed."
  (let ((it matrix))
    (when types 
          (setf it (select matrix (iseq (select (size matrix) 0)) 
                           ($position '("numeric") types))))
    (setf it (normalize (center it) 1))
    (/ (matmult (transpose it) it) 
       (- (select (array-dimensions it) 0) 1))))




(defun creation-time-functions ()

(defun hide-logo ()
  (setf *hide-logo* t)
  (msw-write-profile-string 
   "ViSta" "HideLogo" "Yes" (strcat *default-path* "wxls32.ini")))

(defun show-logo ()
  (setf *hide-logo* nil)
  (msw-write-profile-string 
   "ViSta" "HideLogo" "No" (strcat *default-path* "wxls32.ini")))

);END OF CREATION-TIME-FUNCTIONS - FORMERLY END OF VISTA001.LSP CODE


